(DE TRANSFORM (E R DONE) (COND ((MEMBER E DONE) E)
(T ((LAMBDA (W) (COND ((EQ W E) (COND ((ATOM E) E) (T ((LAMBDA (X Y) (COND
((AND (EQ X (CAR E)) (EQ Y (CDR E))) (SIDE E
(SETQ DONE (CONS E DONE)))) (T (TRANSFORM (CONS X Y) R DONE))))
(TRANSFORM (CAR E) R DONE) (TRANSFORM (CDR E) R DONE)))))
(T (TRANSFORM W R DONE)))) (TRANSA E R)))))

(DE TRANSA (E R) (COND ((NULL R) E) (T 
((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R))) (T W)))
(TRANSB E (CAR R))))))

(DE TRANSB (E RULE) ((LAMBDA (W) (COND ((OR (EQ W (QUOTE NO))
(NOT (EVAL (CADR RULE) W))) E)
((CADDR RULE) (SUBLIS (CADDDR RULE) W))
(T (EVAL (CADDDR RULE) W)))) (INST E (CAR RULE) NIL)))

(DE SIDE (X Y) X)

(SETQ R1 (QUOTE (
((PLUS.X) (MEMBER 0 X) NIL (CONS (QUOTE PLUS) (DZ X)))
((TIMES.X) (MEMBER 0 X) T 0)
((TIMES.X) (MEMBER 1 X) NIL (CONS (QUOTE TIMES) (D1 X)))
((PLUS) T T 0)
((PLUS X) T T X)
((TIMES) T T 1)
((TIMES X) T T X)
)))

(DE DZ (U) (COND ((NULL U) NIL) ((EQ (CAR U) 0) (DZ (CDR U)))
((AND (NOT (ATOM (CAR U))) (EQ (CAAR U) (QUOTE PLUS)))
(APPEND (CDAR U) (DZ (CDR U)))) (T (CONS (CAR U)
(DZ (CDR U))))))

(DE D1 (U) (COND ((NULL U) NIL) ((EQ (CAR U) 1) (D1 (CDR U)))
((AND (NOT (ATOM (CAR U))) (EQ (CAAR U) (QUOTE TIMES)))
(APPEND (CDAR U) (D1 (CDR U)))) (T (CONS (CAR U)
(D1 (CDR U))))))